;Inteligencia Artificial II
;Actividad 1 - Familia
;Alfonso Sendra Gamero

(clear)

;Plantilla para persona
(deftemplate persona
   (slot nombre)
   (slot sexo (allowed-values hombre mujer))
   (slot padre)
   (slot madre)
   (slot conyuge)
   (multislot hijos)
   (multislot hermanos)
   (multislot tios)
   (multislot abuelos (cardinality 0 2))
   (multislot nietos)
   (multislot primos)
)

;Hechos iniciales
(deffacts initial-fact
   (persona (nombre Sofia) (sexo mujer) (conyuge Juan) (hijos Carlos Mateo Clara))
   (persona (nombre Juan) (sexo hombre) (conyuge Sofia) (hijos Carlos Mateo Clara))
   (persona (nombre Carlos) (sexo hombre) (padre Juan) (madre Sofia) (hermanos Mateo Clara))
   (persona (nombre Mateo) (sexo hombre) (padre Juan) (madre Sofia) (conyuge Calixta) (hijos Amancio Amanda) (hermanos Carlos Clara))
   (persona (nombre Clara) (sexo mujer) (padre Juan) (madre Sofia) (conyuge Joao) (hijos Pepito Julia) (hermanos Mateo Carlos))
   (persona (nombre Amancio) (sexo hombre) (padre Mateo) (madre Calixta) (hermanos Amanda))
   (persona (nombre Amanda) (sexo mujer) (padre Mateo) (madre Calixta) (hermanos Amancio))
   (persona (nombre Pepito) (sexo hombre) (padre Joao) (madre Clara) (hermanos Julia))
   (persona (nombre Julia) (sexo mujer) (padre Joao) (madre Clara) (conyuge Mario) (hijos Julieta Juanete) (hermanos Pepito))
   (persona (nombre Pepito) (sexo hombre) (padre Joao) (madre Clara) (hermanos Julia))
   (persona (nombre Juanete) (sexo hombre) (padre Mario) (madre Julia) (hermanos Julieta))
   (persona (nombre Julieta) (sexo mujer) (padre Mario) (madre Julia) (hermanos Juanete))
)

(reset)

;regla para los abuelos paternos
;y para sus nietos
(defrule r_abuelo_paterno
   ?dir1 <- (persona (nombre ?nieto) (padre ?padre) (abuelos $?abuelos))
   (persona (nombre ?padre) (padre ?abuelo))
   ?dir2 <- (persona (nombre ?abuelo) (nietos $?nietos))
   (test (not (member$ ?abuelo $?abuelos)))
   (test (not (member$ ?nieto $?nietos)))
    => (printout t "el abuelo paterno de " ?nieto " es " ?abuelo crlf)
       (modify ?dir1 (abuelos $?abuelos ?abuelo))
	   (modify ?dir2 (nietos $?nietos ?nieto))
)

;regla para las abuelas paternas 
;y para sus nietos
(defrule r_abuela_paterna
   ?dir1 <- (persona (nombre ?nieto) (padre ?padre) (abuelos $?abuelos))
   (persona (nombre ?padre) (madre ?abuelo))
   ?dir2 <- (persona (nombre ?abuelo) (nietos $?nietos))
   (test (not (member$ ?abuelo $?abuelos)))
   (test (not (member$ ?nieto $?nietos)))
    => (printout t "la abuela paterna de " ?nieto " es " ?abuelo crlf)
       (modify ?dir1 (abuelos $?abuelos ?abuelo))
	   (modify ?dir2 (nietos $?nietos ?nieto))
)

;regla para los abuelos maternos
;y para sus nietos
(defrule r_abuelo_materno
   ?dir1 <- (persona (nombre ?nieto) (madre ?madre) (abuelos $?abuelos))
   (persona (nombre ?madre) (padre ?abuelo))
   ?dir2 <- (persona (nombre ?abuelo) (nietos $?nietos))
   (test (not (member$ ?abuelo $?abuelos)))
   (test (not (member$ ?nieto $?nietos)))
    => (printout t "el abuelo materno de " ?nieto " es " ?abuelo crlf)
       (modify ?dir1 (abuelos $?abuelos ?abuelo))
	   (modify ?dir2 (nietos $?nietos ?nieto))
)

;regla para las abuelas maternas 
;y para sus nietos
(defrule r_abuela_materna
   ?dir1 <- (persona (nombre ?nieto) (madre ?madre) (abuelos $?abuelos))
   (persona (nombre ?madre) (madre ?abuelo))
   ?dir2 <- (persona (nombre ?abuelo) (nietos $?nietos))
   (test (not (member$ ?abuelo $?abuelos)))
   (test (not (member$ ?nieto $?nietos)))
    => (printout t "la abuela materna de " ?nieto " es " ?abuelo crlf)
       (modify ?dir1 (abuelos $?abuelos ?abuelo))
	   (modify ?dir2 (nietos $?nietos ?nieto))
)

;regla para los tios por parte de padre
(defrule r_tios_paternos
	?dir1 <- (persona (nombre ?sobrino) (padre ?padre) (tios $?tios))
	(persona (nombre ?padre) (hermanos $?hermanos))
	(persona (nombre ?tio))
	(test (member$ ?tio $?hermanos))
	(test (not (member$ ?tio $?tios)))
	=> (printout t "un tio paterno de " ?sobrino " es " ?tio crlf)
	   (modify ?dir1 (tios $?tios ?tio))
)

;regla para los tios por parte de madre
(defrule r_tios_maternos
	?dir1 <- (persona (nombre ?sobrino) (madre ?madre) (tios $?tios))
	(persona (nombre ?madre) (hermanos $?hermanos))
	(persona (nombre ?tio))
	(test (member$ ?tio $?hermanos))
	(test (not (member$ ?tio $?tios)))
	=> (printout t "un tio materno de " ?sobrino " es " ?tio crlf)
	   (modify ?dir1 (tios $?tios ?tio))
)

;regla para los primos por parte de tio
;indico su sexo
(defrule primos_por_tio_con_sexo
	?dir1 <- (persona (nombre ?nombre) (tios $?tios) (primos $?primos))
	(persona (nombre ?tio))
	(persona (nombre ?primo) (padre ?tio) (sexo ?sexo))
	(test (member$ ?tio $?tios))
	(test (not (member$ ?primo $?primos)))
	=> 
	   (printout t "un primo de " ?nombre " es " ?primo " y tiene sexo " ?sexo crlf)
	   (modify ?dir1 (primos $?primos ?primo))
)

;regla para los primos por parte de tio
;indico su sexo
(defrule primos_por_tia_con_sexo
	?dir1 <- (persona (nombre ?nombre) (tios $?tios) (primos $?primos))
	(persona (nombre ?tio))
	(persona (nombre ?primo) (madre ?tio) (sexo ?sexo))
	(test (member$ ?tio $?tios))
	(test (not (member$ ?primo $?primos)))
	=> 
	   (printout t "un primo de " ?nombre " es " ?primo " y tiene sexo " ?sexo crlf)
	   (modify ?dir1 (primos $?primos ?primo))
)

;;; regla para determinar los hermanos
;;; la explico paso a paso
(defrule XXX
	(persona (nombre ?x) (hijos $?hijos)) 					;; Precondicion 1: para todos los miembros de la familia
	?f <- (persona (nombre ?y) (madre ?x) (hermanos $?h))  	;; Precondicion 2: para todos los hijos que tienen una madre
															;; Guardo en $f el numero de hecho que cumple la anterior precondicion
	(test (not (subsetp $?h $?hijos)))						;; Tengo que introducir este test porque si no la regla entra en un bucle 
													;; infinito al reevaluarse la regla cada vez que se modifica el hecho
	=> 
	   (bind ?pos (member$ ?y $?hijos))				;; Guardo en $pos la posicion del hijo $y dentro del campo $?hijos de su madre
	   (bind $?lista (delete$ $?hijos ?pos ?pos))   ;; Guardo en $?lista el resultado de quitar el elemento ?pos, que se corresponde
													;; con ?y, de $?hijos. Obtengo la lista de hermanos de ?y
	   (modify ?f (hermanos $?lista))				;; Modifico el hecho del hijo ?y con su lista de hermanos
	   (printout t "lista: " ?y " " $?lista crlf)
)
